home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / mobile / fma-2.0-stable-setup.exe / {app} / source / uContactSync.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-07  |  29.2 KB  |  1,033 lines
  1. unit uContactSync;
  2.  
  3. {
  4. *******************************************************************************
  5. * Descriptions: Main Contact Sync Unit
  6. * $Source: /cvsroot/fma/fma/uContactSync.pas,v $
  7. * $Locker:  $
  8. *
  9. * Todo:
  10. *   - Let the OOD reflect the xml
  11. *   - Filters on the external contacts
  12. *   - Hash sperate items of a contact so less conflicts arise
  13. *   - Do it using interfaces. IIdentifiable INameble IConflictSolver ISynchronizable
  14. *
  15. * Change Log:
  16. * $Log: uContactSync.pas,v $
  17. * Revision 1.9  2004/07/07 09:39:49  z_stoichev
  18. * Resolved warnings
  19. *
  20. * Revision 1.8  2004/06/26 16:47:09  lordlarry
  21. * Contacts can be Unlinked
  22. *
  23. * Revision 1.7  2004/06/25 18:27:09  lordlarry
  24. * Added this changelog header
  25. *
  26. *
  27. }
  28.  
  29. interface
  30.  
  31. uses
  32.   Contnrs, Classes, SysUtils;
  33.  
  34. const
  35.   MaxCardinal = High(Cardinal);
  36.  
  37. type
  38.   ESynchronize = class(Exception);
  39.  
  40.   TContactState = (csUnknown, csUnchanged, csNew, csChanged, csDeleted);
  41.   TContactSollution = (slLeft, slRight, slNeither);
  42.   TContactAction = (caAdd, caUpdate, caDelete, caUnlink);
  43.   TContactActions = set of TContactAction;
  44.  
  45.   TBaseContact = class(TObject)
  46.   private
  47.     FTitle: WideString;
  48.     FCellPhone: WideString;
  49.     FFaxPhone: WideString;
  50.     FOtherPhone: WideString;
  51.     FOrganization: WideString;
  52.     FEmail: WideString;
  53.     FName: WideString;
  54.     FWorkPhone: WideString;
  55.     FSurName: WideString;
  56.     FHomePhone: WideString;
  57.     function GetFullName: WideString;
  58.   public
  59.     property Title: WideString read FTitle write FTitle;
  60.     property Name: WideString read FName write FName;
  61.     property SurName: WideString read FSurName write FSurName;
  62.     property Organization: WideString read FOrganization write FOrganization;
  63.     property Email: WideString read FEmail write FEmail;
  64.     property HomePhone: WideString read FHomePhone write FHomePhone;
  65.     property WorkPhone: WideString read FWorkPhone write FWorkPhone;
  66.     property CellPhone: WideString read FCellPhone write FCellPhone;
  67.     property FaxPhone: WideString read FFaxPhone write FFaxPhone;
  68.     property OtherPhone: WideString read FOtherPhone write FOtherPhone;
  69.  
  70.     property FullName: WideString read GetFullName;
  71.   end;
  72.  
  73.   TContactSource = class;
  74.  
  75.   TContact = class(TBaseContact)
  76.   private
  77.     FSyncID: Cardinal;
  78.     FID: Variant;
  79.     FSyncHash: Cardinal;
  80.     FLinkedContact: TContact;
  81.     FSynchronized: Boolean;
  82.     FContactSource: TContactSource;
  83.     function GetHash: Cardinal;
  84.   protected
  85.     function GetHashString: String; virtual;
  86.     function Exists: Boolean; virtual; abstract;
  87.   public
  88.     constructor Create(ContactSource: TContactSource);
  89.     property ContactSource: TContactSource read FContactSource write FContactSource;
  90.  
  91.     property Synchronized: Boolean read FSynchronized write FSynchronized;
  92.  
  93.     property SyncID: Cardinal read FSyncID write FSyncID;
  94.     property ID: Variant read FID write FID;
  95.     property SyncHash: Cardinal read FSyncHash write FSyncHash;
  96.     property Hash: Cardinal read GetHash;
  97.     property LinkedContact: TContact read FLinkedContact write FLinkedContact;
  98.  
  99.     function IsUnchanged: Boolean;
  100.     function IsNew: Boolean; virtual;
  101.     function IsChanged: Boolean; virtual;
  102.     function IsDeleted: Boolean; virtual;
  103.     function GetContactState: TContactState;
  104.  
  105.     procedure Clone(Value: TContact);
  106.   end;
  107.  
  108.   TContacts = class
  109.   private
  110.     FList: TObjectList;
  111.     function GetItem(Index: Integer): TContact;
  112.     function GetCount: Integer;
  113.     procedure PutItem(Index: Integer; const Value: TContact);
  114.   public
  115.     constructor Create;
  116.     destructor Destroy; override;
  117.  
  118.     function Add(Item: TContact): Integer;
  119.     procedure Clear;
  120.     procedure Delete(Index: Integer);
  121.     procedure Remove(Item: TContact);
  122.     function IndexOf(Item: TContact): Integer;
  123.     property Count: Integer read GetCount;
  124.     property Items[Index: Integer]: TContact read GetItem write PutItem; default;
  125.     function FindByID(ID: Variant): TContact;
  126.     function FindBySyncID(SyncID: Cardinal): TContact;
  127.   end;
  128.  
  129.   TContactSource = class
  130.   private
  131.     FContacts: TContacts;
  132.     FConfirmActions: TContactActions;
  133.   protected
  134.     function GetName: String; virtual; abstract;
  135.     function DeformatPhoneNumber(PhoneNumber: String): String; virtual;
  136.   public
  137.     constructor Create;
  138.     destructor Destroy; override;
  139.  
  140.     property Name: String read GetName;
  141.  
  142.     property Contacts: TContacts read FContacts;
  143.  
  144.     function New: TContact; virtual; abstract;
  145.     function Add(Value: TContact): TContact; virtual; abstract;
  146.     procedure Update(Contact, Value: TContact); virtual; abstract;
  147.     procedure Delete(Contact: TContact); virtual; abstract;
  148.     function Find(SyncID: Cardinal): TContact;
  149.     procedure Unlink(Contact: TContact); virtual;
  150.  
  151.     procedure Load; virtual; abstract;
  152.  
  153.     property ConfirmActions: TContactActions read FConfirmActions write FConfirmActions;
  154.   end;
  155.  
  156.   TPossibleLink = class
  157.   private
  158.     FScore: Integer;
  159.     FContact: TContact;
  160.   public
  161.     property Contact: TContact read FContact write FContact;
  162.     property Score: Integer read FScore write FScore;
  163.   end;
  164.  
  165.   TPossibleLinks = class
  166.   private
  167.     FList: TObjectList;
  168.     function GetItem(Index: Integer): TPossibleLink;
  169.     function GetCount: Integer;
  170.     procedure PutItem(Index: Integer; const Value: TPossibleLink);
  171.   public
  172.     constructor Create;
  173.     destructor Destroy; override;
  174.  
  175.     function Add(Contact: TContact; Score: Integer): Integer;
  176.     procedure Clear;
  177.     procedure Delete(Index: Integer);
  178.     procedure Remove(Item: TPossibleLink);
  179.     function IndexOf(Item: TPossibleLink): Integer;
  180.     property Count: Integer read GetCount;
  181.     property Items[Index: Integer]: TPossibleLink read GetItem write PutItem; default;
  182.     procedure Sort;
  183.   end;
  184.  
  185.   TSyncContactsConflictEvent = procedure(Sender: TObject; Contact: TContact;
  186.     const Description: WideString; const Item0Name, Item1Name: String; var SelectedItem: Integer) of object;
  187.   TSyncContactsFirstTimeEvent = procedure(Sender: TObject; var Continue: Boolean) of object;
  188.   TSyncContactsErrorEvent = procedure(Sender: TObject; const Message: String) of object;
  189.   TSyncContactsConfirmEvent = procedure(Sender: TObject; Contact: TContact; Action: TContactAction;
  190.       const Description: WideString; var Confirmed: Boolean) of object;
  191.   TSyncContactsChooseContactEvent = procedure(Sender: TObject; Contact: TContact; PossibleLinks: TPossibleLinks; var OtherContact: TContact) of object;
  192.  
  193.   TSynchronizeContacts = class
  194.   private
  195.     FFMA: TContactSource;
  196.     FExtern: TContactSource;
  197.     FFileName: String;
  198.     FOnConflict: TSyncContactsConflictEvent;
  199.     FSWitched: Boolean;
  200.     FOnFirstTime: TSyncContactsFirstTimeEvent;
  201.     FOnError: TSyncContactsErrorEvent;
  202.     FOnConfirm: TSyncContactsConfirmEvent;
  203.     FOnChooseLink: TSyncContactsChooseContactEvent;
  204.     procedure DoSynchronize(Left, Right: TContactSource);
  205.     function CalculateLinkScore(Contact, OtherContact: TContact): Integer;
  206.     function FindLink(Contact: TContact; OtherSource: TContactSource): TContact;
  207.     function Conflict(Left, Right: TContact): TContactSollution;
  208.     function Confirm(Action: TContactAction; Source: TContactSource; Contact: TContact): Boolean;
  209.     function BuildCompareDescription(Contact, OtherContact: TContact): WideString;
  210.     function BuildActionDescription(Action: TContactAction; Source: TContactSource; Contact: TContact): WideString;
  211.     function Add(Source: TContactSource; Value: TContact): TContact;
  212.     procedure Update(Source: TContactSource; Contact, Value: TContact);
  213.     procedure Delete(Source: TContactSource; Contact, OtherContact: TContact);
  214.     procedure Link(Contact, OtherContact: TContact);
  215.   protected
  216.     procedure DoConflict(Contact: TContact;
  217.       const Description: WideString; const Item0Name, Item1Name: String;
  218.       var SelectedItem: Integer); virtual;
  219.     function DoFirstTime: Boolean; virtual;
  220.     procedure DoError(const Message: String); virtual;
  221.     procedure DoConfirm(Contact: TContact; Action: TContactAction;
  222.       const Description: WideString; var Confirmed: Boolean); virtual;
  223.     procedure DoChooseLink(Contact: TContact; PossibleLinks: TPossibleLinks; var OtherContact: TContact); virtual;
  224.   public
  225.     property FileName: String read FFileName write FFileName;
  226.     property FMA: TContactSource read FFMA write FFMA;
  227.     property Extern: TContactSource read FExtern write FExtern;
  228.     property OnConflict: TSyncContactsConflictEvent read FOnConflict write FOnConflict;
  229.     property OnFirstTime: TSyncContactsFirstTimeEvent read FOnFirstTime write FOnFirstTime;
  230.     property OnError: TSyncContactsErrorEvent read FOnError write FOnError;
  231.     property OnConfirm: TSyncContactsConfirmEvent read FOnConfirm write FOnConfirm;
  232.     property OnChooseLink: TSyncContactsChooseContactEvent read FOnChooseLink write FOnChooseLink;
  233.  
  234.     procedure Load;
  235.     procedure Synchronize;
  236.     procedure Save;
  237.  
  238.     procedure Unlink(CDID: TGUID);
  239.   end;
  240.  
  241. procedure SyncLog(const Msg: String);
  242. procedure SyncLogFmt(const Msg: String; const Args: array of const);
  243.  
  244. implementation
  245.  
  246. uses
  247.   Forms, Variants, uXMLContactSync, CRC32, uSyncPhonebook, Unit1;
  248.  
  249. procedure SyncLog(const Msg: String);
  250. begin
  251.   Form1.SyncLog(Msg, True);
  252. end;
  253.  
  254. procedure SyncLogFmt(const Msg: String; const Args: array of const);
  255. begin
  256.   SyncLog(Format(Msg, Args));
  257. end;
  258.  
  259. { TSynchronizeContacts }
  260.  
  261. procedure TSynchronizeContacts.DoSynchronize(Left, Right: TContactSource);
  262. var I: Integer;
  263.     LeftContact, RightContact: TContact;
  264.     LeftState, RightState: TContactState;
  265.     Sollution: TContactSollution;
  266. begin
  267.   for I := 0 to Left.Contacts.Count - 1 do begin
  268.     LeftContact := Left.Contacts[I];
  269.     if not LeftContact.Synchronized then begin
  270.       LeftState := LeftContact.GetContactState;
  271.  
  272.       RightContact := LeftContact.LinkedContact;
  273.  
  274.       if LeftState = csNew then begin
  275.         RightContact := FindLink(LeftContact, Right);
  276.         if Assigned(RightContact) then
  277.           Link(LeftContact, RightContact)
  278.         else
  279.           Add(Right, LeftContact);
  280.       end
  281.       else begin
  282.         if not Assigned(RightContact) then
  283.           raise ESynchronize.Create('Linked contact not found');
  284.  
  285.         RightState := RightContact.GetContactState;
  286.  
  287.         if LeftState = csChanged then begin
  288.           if RightState = csUnchanged then begin
  289.             Update(Right, RightContact, LeftContact);
  290.           end
  291.           else if RightState = csChanged then begin
  292.             Sollution := Conflict(LeftContact, RightContact);
  293.             if Sollution = slLeft then begin
  294.               Update(Right, RightContact, LeftContact);
  295.             end
  296.             else if Sollution = slRight then begin
  297.               Update(Left, LeftContact, RightContact);
  298.             end;
  299.           end
  300.           else if RightState = csDeleted then begin
  301.             Sollution := Conflict(LeftContact, RightContact);
  302.             if Sollution = slLeft then begin
  303.               Add(Right, LeftContact);
  304.             end
  305.             else if Sollution = slRight then begin
  306.               Delete(Left, LeftContact, RightContact);
  307.             end;
  308.           end;
  309.         end
  310.         else if LeftState = csDeleted then begin
  311.           if RightState = csUnchanged then begin
  312.             Delete(Right, RightContact, LeftContact);
  313.           end
  314.           else if RightState = csChanged then begin
  315.             Sollution := Conflict(LeftContact, RightContact);
  316.             if Sollution = slLeft then begin
  317.               Delete(Right, RightContact, LeftContact);
  318.             end
  319.             else if Sollution = slRight then begin
  320.               Add(Left, RightContact);
  321.             end;
  322.           end;
  323.         end;
  324.       end;
  325.  
  326.       { Allow synchronization to be canceled }
  327.       Application.ProcessMessages;
  328. //      if Form1.FAbortDetected then break;
  329.     end;
  330.   end;
  331. end;
  332.  
  333. procedure TSynchronizeContacts.Synchronize;
  334. begin
  335.   SyncLog('Synchronize started');
  336.   try
  337.     FSwitched := False;
  338.     DoSynchronize(FMA, Extern);
  339.     FSwitched := True;
  340.     DoSynchronize(Extern, FMA);
  341.  
  342.     SyncLog('Synchronize completed');
  343.   except
  344.     on E: ESynchronize do begin
  345.       SyncLogFmt('Synchronize error: %s', [E.Message]);
  346.       DoError(E.Message);
  347.     end;
  348.   end;
  349. end;
  350.  
  351. function TSynchronizeContacts.Conflict(Left, Right: TContact): TContactSollution;
  352. var Contact, OtherContact: TContact;
  353.     SelectedItem: Integer;
  354.     Description: WideString;
  355. begin
  356.   if FSwitched then begin
  357.     Contact := Right;
  358.     OtherContact := Left;
  359.   end
  360.   else begin
  361.     Contact := Left;
  362.     OtherContact := Right;
  363.   end;
  364.  
  365.   SyncLogFmt('%s has a conflict', [Contact.FullName]);
  366.  
  367.   SelectedItem := 0;
  368.  
  369.   Description := BuildCompareDescription(Contact, OtherContact);
  370.  
  371.   DoConflict(Contact, Description, Contact.ContactSource.Name, Contact.LinkedContact.ContactSource.Name, SelectedItem);
  372.  
  373.   case SelectedItem of
  374.     0: begin
  375.       if Contact = Left then
  376.         Result := slLeft
  377.       else
  378.         Result := slRight;
  379.       SyncLogFmt('Conflict has been solved in favor of %s', [Contact.ContactSource.Name]);
  380.     end;
  381.     1: begin
  382.       if Contact = Left then
  383.         Result := slRight
  384.       else
  385.         Result := slLeft;
  386.       SyncLogFmt('Conflict has been solved in favor of %s', [Contact.LinkedContact.ContactSource.Name]);
  387.     end;
  388.     else begin
  389.       Result := slNeither;
  390.       SyncLog('Conflict has not been solved');
  391.     end;
  392.   end;
  393. end;
  394.  
  395. procedure TSynchronizeContacts.Load;
  396. var XMLContactSync: IXMLFmaSyncType;
  397.     XMLContact: IXMLContactType;
  398.     I: Integer;
  399.     FMAContact: TContact;
  400.     ExternContact: TContact;
  401. begin
  402.   SyncLog('Loading started');
  403.   try
  404.     if FileExists(FFileName) then begin
  405.       XMLContactSync := Loadfmasync(FFileName);
  406.       for I := 0 to XMLContactSync.Count - 1 do begin
  407.         XMLContact := XMLContactSync.Contact[I];
  408.  
  409.         FMAContact := FMA.New;
  410.         FMAContact.SyncID := XMLContact.SyncID;
  411.         FMAContact.ID := XMLContact.FMA.ID;
  412.         FMAContact.SyncHash := StrToInt(XMLContact.FMA.Hash);
  413.         FMA.Contacts.Add(FMAContact);
  414.  
  415.         ExternContact := Extern.New;
  416.         ExternContact.SyncID := XMLContact.SyncID;
  417.         ExternContact.ID := XMLContact.Extern.ID;
  418.         ExternContact.SyncHash := StrToInt(XMLContact.Extern.Hash);
  419.         Extern.Contacts.Add(ExternContact);
  420.  
  421.         FMAContact.LinkedContact := ExternContact;
  422.         ExternContact.LinkedContact := FMAContact;
  423.  
  424.         Application.ProcessMessages;
  425.       end;
  426.  
  427.       SyncLogFmt('Loaded %d contacts from XML', [XMLContactSync.Count]);
  428.     end
  429.     else
  430.       if not DoFirstTime then Abort;
  431.  
  432.     FMA.Load;
  433.     Extern.Load;
  434.  
  435.     SyncLog('Loading completed');
  436.   except
  437.     on E: ESynchronize do begin
  438.       SyncLogFmt('Loading error: %s', [E.Message]);
  439.       DoError(E.Message);
  440.     end;
  441.   end;
  442. end;
  443.  
  444. procedure TSynchronizeContacts.Save;
  445. var XMLContactSync: IXMLFmaSyncType;
  446.     XMLContact: IXMLContactType;
  447.     I: Integer;
  448.     FMAContact: TContact;
  449.     ExternContact: TContact;
  450.     ID: Integer;
  451. begin
  452.   SyncLog('Saving started');
  453.   try
  454.     XMLContactSync := Newfmasync;
  455.  
  456.     ID := 0;
  457.  
  458.     for I := 0 to FMA.Contacts.Count - 1 do begin
  459.       FMAContact := FMA.Contacts[I];
  460.       ExternContact := FMAContact.LinkedContact;
  461.  
  462.       if Assigned(ExternContact) and (not FMAContact.IsDeleted) and (not ExternContact.IsDeleted) then begin
  463.         XMLContact := XMLContactSync.Add;
  464.         XMLContact.SyncID := ID;
  465.  
  466.         XMLContact.FMA.ID := FMAContact.ID;
  467.         XMLContact.FMA.Hash := '$' + IntToHex(FMAContact.Hash, 8);
  468.  
  469.         XMLContact.Extern.ID := ExternContact.ID;
  470.         XMLContact.Extern.Hash := '$' + IntToHex(ExternContact.Hash, 8);
  471.  
  472.         Inc(ID);
  473.       end;
  474.  
  475.       Application.ProcessMessages;
  476.     end;
  477.  
  478.     XMLContactSync.OwnerDocument.SaveToFile(FFileName);
  479.  
  480.     SyncLog('Saving completed');
  481.   except
  482.     on E: ESynchronize do begin
  483.       SyncLogFmt('Saving error: %s', [E.Message]);
  484.       DoError(E.Message);
  485.     end;
  486.   end;
  487. end;
  488.  
  489. procedure TSynchronizeContacts.DoConflict(Contact: TContact; const Description: 
  490.     WideString; const Item0Name, Item1Name: String; var SelectedItem: Integer);
  491. begin
  492.   SelectedItem := 0;
  493.  
  494.   if Assigned(FOnConflict) then
  495.     FOnConflict(Self, Contact, Description, Item0Name, Item1Name, SelectedItem);
  496.  
  497.   if SelectedItem = -1 then
  498.     SelectedItem := 0;
  499. end;
  500.  
  501. function TSynchronizeContacts.DoFirstTime: Boolean;
  502. begin
  503.   Result := True;
  504.   
  505.   if Assigned(FOnFirstTime) then
  506.     FOnFirstTime(Self, Result);
  507. end;
  508.  
  509. procedure TSynchronizeContacts.DoError(const Message: String);
  510. begin
  511.   if Assigned(FOnError) then
  512.     FOnError(Self, Message);
  513. end;
  514.  
  515. function TSynchronizeContacts.BuildCompareDescription(Contact, OtherContact: 
  516.     TContact): WideString;
  517. var FullName: WideString;
  518. begin
  519.   if Contact.FullName <> '' then
  520.     FullName := Contact.FullName
  521.   else
  522.     FullName := OtherContact.FullName;
  523.  
  524.   case Contact.GetContactState of
  525.     csUnchanged:
  526.       Result := WideFormat('%s is unchanged in %s', [FullName, Contact.ContactSource.Name]);
  527.     csNew:
  528.       Result := WideFormat('%s is new in %s', [FullName, Contact.ContactSource.Name]);
  529.     csChanged:
  530.       Result := WideFormat('%s is changed in %s', [FullName, Contact.ContactSource.Name]);
  531.     csDeleted:
  532.       Result := WideFormat('%s is deleted from %s', [FullName, Contact.ContactSource.Name]);
  533.     else
  534.       Result := '';
  535.   end;
  536.  
  537.   case OtherContact.GetContactState of
  538.     csUnchanged:
  539.       Result := Result + WideFormat(' and unchanged in %s', [OtherContact.ContactSource.Name]);
  540.     csNew:
  541.       Result := Result + WideFormat(' and new in %s', [OtherContact.ContactSource.Name]);
  542.     csChanged:
  543.       Result := Result + WideFormat(' and changed in %s', [OtherContact.ContactSource.Name]);
  544.     csDeleted:
  545.       Result := Result + WideFormat(' and deleted from %s', [OtherContact.ContactSource.Name]);
  546.   end;
  547. end;
  548.  
  549. function TSynchronizeContacts.BuildActionDescription(Action: TContactAction;
  550.     Source: TContactSource; Contact: TContact): WideString;
  551. begin
  552.   case Action of
  553.     caAdd:
  554.       Result := WideFormat('%s will be added to %s', [Contact.FullName, Source.Name]);
  555.     caUpdate:
  556.       Result := WideFormat('%s will be updated into %s', [Contact.FullName, Source.Name]);
  557.     caDelete:
  558.       Result := WideFormat('%s will be deleted from %s', [Contact.FullName, Source.Name]);
  559.     else
  560.       Result := '';
  561.   end;
  562. end;
  563.  
  564. function TSynchronizeContacts.Confirm(Action: TContactAction; Source: TContactSource; Contact: TContact): Boolean;
  565. var Description: WideString;
  566. begin
  567.   SyncLogFmt('Confirmation is asked for %s', [Contact.FullName]);
  568.  
  569.   Description := BuildActionDescription(Action, Source, Contact);
  570.  
  571.   DoConfirm(Contact, Action, Description, Result);
  572.  
  573.   if Result then
  574.     SyncLog('Confirmation is granted')
  575.   else
  576.     SyncLog('Confirmation is not granted');
  577. end;
  578.  
  579. procedure TSynchronizeContacts.DoConfirm(Contact: TContact; Action: 
  580.     TContactAction; const Description: WideString; var Confirmed: Boolean);
  581. begin
  582.   Confirmed := True;
  583.   if Assigned(FOnConfirm) then
  584.     FOnConfirm(Self, Contact, Action, Description, Confirmed);
  585. end;
  586.  
  587. function TSynchronizeContacts.Add(Source: TContactSource; Value: TContact): TContact;
  588. begin
  589.   Result := nil;
  590.  
  591.   if caAdd in Source.ConfirmActions then
  592.     if not Confirm(caAdd, Source, Value) then Exit;
  593.  
  594.   Result := Source.Add(Value);
  595.  
  596.   Result.Synchronized := True;
  597.   Value.Synchronized := True;
  598.   SyncLogFmt('%s is added to %s', [Result.FullName, Source.Name]);
  599. end;
  600.  
  601. procedure TSynchronizeContacts.Update(Source: TContactSource; Contact, Value: TContact);
  602. begin
  603.   if caUpdate in Source.ConfirmActions then
  604.     if not Confirm(caUpdate, Source, Value) then Exit;
  605.  
  606.   Source.Update(Contact, Value);
  607.  
  608.   Contact.Synchronized := True;
  609.   Value.Synchronized := True;
  610.   SyncLogFmt('%s is updated into %s', [Contact.FullName, Source.Name]);
  611. end;
  612.  
  613. procedure TSynchronizeContacts.Delete(Source: TContactSource; Contact, OtherContact: TContact);
  614. begin
  615.   if caDelete in Source.ConfirmActions then
  616.     if not Confirm(caDelete, Source, Contact) then Exit;
  617.  
  618.   Source.Delete(Contact);
  619.  
  620.   Contact.Synchronized := True;
  621.   OtherContact.Synchronized := True;
  622.   SyncLogFmt('%s is deleted from %s', [Contact.FullName, Source.Name]);
  623. end;
  624.  
  625. procedure TSynchronizeContacts.Link(Contact, OtherContact: TContact);
  626. begin
  627.   Contact.LinkedContact := OtherContact;
  628.   OtherContact.LinkedContact := Contact;
  629.  
  630.   SyncLogFmt('%s is linked to %s', [Contact.FullName, OtherContact.Name]);
  631. end;
  632.  
  633. function TSynchronizeContacts.FindLink(Contact: TContact; OtherSource: TContactSource): TContact;
  634. var I: Integer;
  635.     OtherContact: TContact;
  636.     OtherState: TContactState;
  637.     PossibleLinks: TPossibleLinks;
  638.     Score: Integer;
  639. begin
  640.   PossibleLinks := TPossibleLinks.Create;
  641.   try
  642.     for I := 0 to OtherSource.Contacts.Count - 1 do begin
  643.       OtherContact := OtherSource.Contacts[I];
  644.       if Assigned(OtherContact) then begin
  645.         OtherState := OtherContact.GetContactState;
  646.  
  647.         if OtherState = csNew then begin
  648.           Score := CalculateLinkScore(Contact, OtherContact);
  649.           PossibleLinks.Add(OtherContact, Score)
  650.         end;
  651.       end;
  652.     end;
  653.     PossibleLinks.Sort;
  654.  
  655.     OtherContact := nil;
  656.     if PossibleLinks.Count > 0 then
  657.       DoChooseLink(Contact, PossibleLinks, OtherContact);
  658.     Result := OtherContact;
  659.   finally
  660.     PossibleLinks.Free;
  661.   end;
  662. end;
  663.  
  664. function TSynchronizeContacts.CalculateLinkScore(Contact, OtherContact: TContact): Integer;
  665. begin
  666.   Result := 0;
  667.   
  668.   if Contact.Title = OtherContact.Title then
  669.     Inc(Result, 1);
  670.   if Contact.Name = OtherContact.Name then
  671.     Inc(Result, 10);
  672.   if Contact.SurName = OtherContact.SurName then
  673.     Inc(Result, 100);
  674.   if Contact.Organization = OtherContact.Organization then
  675.     Inc(Result, 1);
  676.   if Contact.Email = OtherContact.Email then
  677.     Inc(Result, 100);
  678.   if Contact.HomePhone = OtherContact.HomePhone then
  679.     Inc(Result, 100);
  680.   if Contact.WorkPhone = OtherContact.WorkPhone then
  681.     Inc(Result, 10);
  682.   if Contact.CellPhone = OtherContact.CellPhone then
  683.     Inc(Result, 100);
  684.   if Contact.FaxPhone = OtherContact.FaxPhone then
  685.     Inc(Result, 10);
  686.   if Contact.OtherPhone = OtherContact.OtherPhone then
  687.     Inc(Result, 10);
  688.  
  689.   if Contact.Name = OtherContact.SurName then
  690.     Inc(Result, 100);
  691.   if Contact.SurName = OtherContact.Name then
  692.     Inc(Result, 100);
  693. end;
  694.  
  695. procedure TSynchronizeContacts.DoChooseLink(Contact: TContact; PossibleLinks: TPossibleLinks; var OtherContact: TContact);
  696. begin
  697.   if Assigned(FOnChooseLink) then
  698.     FOnChooseLink(Self, Contact, PossibleLinks, OtherContact);
  699. end;
  700.  
  701. procedure TSynchronizeContacts.Unlink(CDID: TGUID);
  702. var XMLContactSync: IXMLFmaSyncType;
  703.     XMLContact: IXMLContactType;
  704.     I: Integer;
  705. //    FMAContact: TContact;
  706. //    ExternContact: TContact;
  707.     Confirmed: Boolean;
  708. begin
  709.   SyncLog('Unlinking started');
  710.   try
  711.     if FileExists(FFileName) then begin
  712.       XMLContactSync := Loadfmasync(FFileName);
  713.       for I := 0 to XMLContactSync.Count - 1 do begin
  714.         XMLContact := XMLContactSync.Contact[I];
  715.  
  716.         if IsEqualGUID(StringToGUID(XMLContact.FMA.ID), CDID) then begin
  717.           Confirmed := False;
  718.           DoConfirm(nil, caUnlink, 'Link found. About to unlinking', Confirmed);
  719.  
  720.           if Confirmed then begin
  721.             SyncLogFmt('Link %s found and Unlinked', [GUIDToString(CDID)]);
  722.             XMLContactSync.Delete(I);
  723.           end;
  724.  
  725.           Break;
  726.         end;
  727.  
  728.         Application.ProcessMessages;
  729.       end;
  730.  
  731.       XMLContactSync.OwnerDocument.SaveToFile(FFileName);
  732.     end;
  733.  
  734.     SyncLog('Unlinking completed');
  735.   except
  736.     on E: ESynchronize do begin
  737.       SyncLogFmt('Unlinking error: %s', [E.Message]);
  738.       DoError(E.Message);
  739.     end;
  740.   end;
  741. end;
  742.  
  743. { TContact }
  744.  
  745. procedure TContact.Clone(Value: TContact);
  746. begin
  747.   inherited;
  748.  
  749.   Title := Value.Title;
  750.   Name := Value.Name;
  751.   SurName := Value.SurName;
  752.   Organization := Value.Organization;
  753.   Email := Value.Email;
  754.   HomePhone := Value.HomePhone;
  755.   WorkPhone := Value.WorkPhone;
  756.   CellPhone := Value.CellPhone;
  757.   FaxPhone := Value.FaxPhone;
  758.   OtherPhone := Value.OtherPhone;
  759.  
  760.   SyncID := Value.SyncID;
  761.   ID := Unassigned;
  762.   SyncHash := Hash;
  763. end;
  764.  
  765. constructor TContact.Create(ContactSource: TContactSource);
  766. begin
  767.   inherited Create;
  768.  
  769.   FContactSource := ContactSource;
  770.  
  771.   FSyncID := MaxCardinal;
  772. end;
  773.  
  774. function TContact.GetContactState: TContactState;
  775. begin
  776.   if IsDeleted then
  777.     Result := csDeleted
  778.   else if IsNew then
  779.     Result := csNew
  780.   else if IsChanged then
  781.     Result := csChanged
  782.   else
  783.     Result := csUnchanged;
  784. end;
  785.  
  786. function TContact.GetHash: Cardinal;
  787. var Str: String;
  788. begin
  789.   Str := GetHashString;
  790.   Result := CalculateCRC32(Str[1], Length(Str));
  791. end;
  792.  
  793. function TContact.GetHashString: String;
  794. begin
  795.   Result := FTitle + FCellPhone + FFaxPhone + FOtherPhone + FOrganization +
  796.             FEmail + FName + FWorkPhone + FSurName + FHomePhone;
  797. end;
  798.  
  799. function TContact.IsChanged: Boolean;
  800. begin
  801.   Result := FSyncHash <> Hash;
  802. end;
  803.  
  804. function TContact.IsDeleted: Boolean;
  805. begin
  806.   Result := not Exists;
  807. end;
  808.  
  809. function TContact.IsNew: Boolean;
  810. begin
  811.   Result := VarIsEmpty(FID) or not Assigned(FLinkedContact);
  812. end;
  813.  
  814. function TContact.IsUnchanged: Boolean;
  815. begin
  816.   Result := not (IsNew or IsChanged or IsDeleted);
  817. end;
  818.  
  819. { TContactSource }
  820.  
  821. constructor TContactSource.Create;
  822. begin
  823.   inherited;
  824.  
  825.   FContacts := TContacts.Create;
  826.   FConfirmActions := [caAdd, caUpdate, caDelete]; 
  827. end;
  828.  
  829. function TContactSource.DeformatPhoneNumber(PhoneNumber: String): String;
  830. const ValidChars = ['*', '#', '+', '0'..'9', 'p'];
  831. var I: Integer;
  832. begin
  833.   Result := '';
  834.   for I := 1 to Length(PhoneNumber) do
  835.     if PhoneNumber[I] in ValidChars then
  836.       Result := Result + PhoneNumber[I];
  837. end;
  838.  
  839. destructor TContactSource.Destroy;
  840. begin
  841.   FContacts.Free;
  842.  
  843.   inherited;
  844. end;
  845.  
  846. function TContactSource.Find(SyncID: Cardinal): TContact;
  847. begin
  848.   Result := FContacts.FindBySyncID(SyncID);
  849. end;
  850.  
  851. procedure TContactSource.Unlink(Contact: TContact);
  852. begin
  853.   if Assigned(Contact.LinkedContact) then begin
  854.     Contact.LinkedContact.LinkedContact := nil;
  855.     Contact.LinkedContact := nil;
  856.   end;
  857. end;
  858.  
  859. { TContacts }
  860.  
  861. function TContacts.Add(Item: TContact): Integer;
  862. begin
  863.   Result := FList.Add(Item);
  864. end;
  865.  
  866. procedure TContacts.Clear;
  867. begin
  868.   FList.Clear;
  869. end;
  870.  
  871. constructor TContacts.Create;
  872. begin
  873.   inherited;
  874.  
  875.   FList := TObjectList.Create;
  876. end;
  877.  
  878. procedure TContacts.Delete(Index: Integer);
  879. begin
  880.   FList.Delete(Index);
  881. end;
  882.  
  883. destructor TContacts.Destroy;
  884. begin
  885.   FList.Free;
  886.  
  887.   inherited;
  888. end;
  889.  
  890. function TContacts.GetItem(Index: Integer): TContact;
  891. begin
  892.   Result := FList[Index] as TContact;
  893. end;
  894.  
  895. function TContacts.GetCount: Integer;
  896. begin
  897.   Result := FList.Count;
  898. end;
  899.  
  900. function TContacts.IndexOf(Item: TContact): Integer;
  901. begin
  902.   Result := FList.IndexOf(Item);
  903. end;
  904.  
  905. procedure TContacts.PutItem(Index: Integer; const Value: TContact);
  906. begin
  907.   FList[Index] := Value;
  908. end;
  909.  
  910. procedure TContacts.Remove(Item: TContact);
  911. begin
  912.   FList.Remove(Item);
  913. end;
  914.  
  915. function TContacts.FindByID(ID: Variant): TContact;
  916. var I: Integer;
  917. begin
  918.   Result := nil;
  919.  
  920.   for I := 0 to Count - 1 do
  921.     if Items[I].ID = ID then begin
  922.       Result := Items[I];
  923.       Break;
  924.     end;
  925. end;
  926.  
  927. function TContacts.FindBySyncID(SyncID: Cardinal): TContact;
  928. var I: Integer;
  929. begin
  930.   Result := nil;
  931.  
  932.   for I := 0 to Count - 1 do
  933.     if Items[I].SyncID = SyncID then begin
  934.       Result := Items[I];
  935.       Break;
  936.     end;
  937. end;
  938.  
  939. { TBaseContact }
  940.  
  941. function TBaseContact.GetFullName: WideString;
  942. begin
  943.   Result := FName;
  944.   if FSurName <> '' then
  945.     if Result <> '' then
  946.       Result := Result + ' ' + FSurName
  947.     else
  948.       Result := FSurName;
  949. end;
  950.  
  951. { TPossibleLinks }
  952.  
  953. constructor TPossibleLinks.Create;
  954. begin
  955.   inherited;
  956.  
  957.   FList := TObjectList.Create;
  958. end;
  959.  
  960. destructor TPossibleLinks.Destroy;
  961. begin
  962.   FList.Free;
  963.  
  964.   inherited;
  965. end;
  966.  
  967. function TPossibleLinks.Add(Contact: TContact; Score: Integer): Integer;
  968. var PossibleLink: TPossibleLink;
  969. begin
  970.   PossibleLink := TPossibleLink.Create;
  971.   PossibleLink.Contact := Contact;
  972.   PossibleLink.Score := Score;
  973.  
  974.  
  975.   Result := FList.Add(PossibleLink);
  976. end;
  977.  
  978. procedure TPossibleLinks.Clear;
  979. begin
  980.   FList.Clear;
  981. end;
  982.  
  983. procedure TPossibleLinks.Delete(Index: Integer);
  984. begin
  985.   FList.Delete(Index);
  986. end;
  987.  
  988. function TPossibleLinks.GetCount: Integer;
  989. begin
  990.   Result := FList.Count;
  991. end;
  992.  
  993. function TPossibleLinks.GetItem(Index: Integer): TPossibleLink;
  994. begin
  995.   Result := FList[Index] as TPossibleLink;
  996. end;
  997.  
  998. function TPossibleLinks.IndexOf(Item: TPossibleLink): Integer;
  999. begin
  1000.   Result := FList.IndexOf(Item);
  1001. end;
  1002.  
  1003. procedure TPossibleLinks.PutItem(Index: Integer; const Value: TPossibleLink);
  1004. begin
  1005.   FList[Index] := Value;
  1006. end;
  1007.  
  1008. procedure TPossibleLinks.Remove(Item: TPossibleLink);
  1009. begin
  1010.   FList.Remove(Item);
  1011. end;
  1012.  
  1013. function PossibleLinksSortCompare(Item1, Item2: Pointer): Integer;
  1014. var Score1, Score2: Integer;
  1015. begin
  1016.   Score1 := TPossibleLink(Item1).Score;
  1017.   Score2 := TPossibleLink(Item2).Score;
  1018.  
  1019.   if Score1= Score2 then
  1020.     Result := 0
  1021.   else if Score1 < Score2 then
  1022.     Result := 1
  1023.   else
  1024.     Result := -1;
  1025. end;
  1026.  
  1027. procedure TPossibleLinks.Sort;
  1028. begin
  1029.   FList.Sort(PossibleLinksSortCompare);
  1030. end;
  1031.  
  1032. end.
  1033.